home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / subnam.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  4KB  |  170 lines
  1. /* subnam.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal value[200000];
  12. } blank_;
  13.  
  14. #define blank_1 blank_
  15.  
  16. /* Table of constant values */
  17.  
  18. static integer c__1 = 1;
  19. static integer c__8 = 8;
  20.  
  21. /*<       subroutine subnam(loce) >*/
  22. /* Subroutine */ int subnam_(loce)
  23. integer *loce;
  24. {
  25.     /* Initialized data */
  26.  
  27.     static struct {
  28.     char e_1[8];
  29.     doublereal e_2;
  30.     } equiv_14 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  31.  
  32. #define ablank (*(doublereal *)&equiv_14)
  33.  
  34.     static struct {
  35.     char e_1[8];
  36.     doublereal e_2;
  37.     } equiv_15 = { {'.', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  38.  
  39. #define aper (*(doublereal *)&equiv_15)
  40.  
  41.     static struct {
  42.     char e_1[8];
  43.     doublereal e_2;
  44.     } equiv_16 = { {'*', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  45.  
  46. #define astk (*(doublereal *)&equiv_16)
  47.  
  48.  
  49.     /* Local variables */
  50.     static integer locv;
  51.     extern /* Subroutine */ int move_();
  52.     static doublereal achar;
  53.     static integer ichar, nchar;
  54.     static doublereal sname;
  55.     static integer locve;
  56.     static doublereal elname;
  57. #define nodplc ((integer *)&blank_1)
  58. #define cvalue ((complex *)&blank_1)
  59.     static integer loc;
  60.  
  61. /*<       implicit double precision (a-h,o-z) >*/
  62.  
  63. /*     this routine constructs the names of elements added as a result of 
  64. */
  65. /* subcircuit expansion.  the full element names are of the form */
  66. /*                  name.xn. --- xd.xc.xb.xa */
  67. /* where 'name' is the nominal element name, and the 'x'*s denote the */
  68. /* sequence of subcircuit calls (from top or circuit level down through */
  69.  
  70. /* nested subcircuit calls) which caused the particular element to be */
  71. /* added.  at present, spice restricts all element names to be 8 charac- 
  72. */
  73. /* ters or less.  therefore, the name used consists of the leftmost 8 */
  74. /* characters of the full element name, with the rightmost character */
  75. /* replaced by an asterisk ('*') if the full element name is longer than 
  76. */
  77. /* 8 characters. */
  78.  
  79. /* spice version 2g.6  sccsid=blank 3/15/83 */
  80. /*<       common /blank/ value(200000) >*/
  81. /*<       integer nodplc(64) >*/
  82. /*<       complex cvalue(32) >*/
  83. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  84.  
  85.  
  86. /*<       data ablank, aper, astk / 1h , 1h., 1h* / >*/
  87.  
  88. /*  construct subcircuit element name */
  89.  
  90. /*<       if (nodplc(loce-1).eq.0) go to 100 >*/
  91.     if (nodplc[*loce - 2] == 0) {
  92.     goto L100;
  93.     }
  94. /*<       locve=nodplc(loce+1) >*/
  95.     locve = nodplc[*loce];
  96. /*<       loc=loce >*/
  97.     loc = *loce;
  98. /*<       nchar=0 >*/
  99.     nchar = 0;
  100. /*<       sname=ablank >*/
  101.     sname = ablank;
  102. /*<       achar=ablank >*/
  103.     achar = ablank;
  104. /*<    10 locv=nodplc(loc+1) >*/
  105. L10:
  106.     locv = nodplc[loc];
  107. /*<       elname=value(locv) >*/
  108.     elname = blank_1.value[locv - 1];
  109. /*<       do 20 ichar=1,8 >*/
  110.     for (ichar = 1; ichar <= 8; ++ichar) {
  111. /*<       call move(achar,1,elname,ichar,1) >*/
  112.     move_(&achar, &c__1, &elname, &ichar, &c__1);
  113. /*<       if (achar.eq.ablank) go to 30 >*/
  114.     if (achar == ablank) {
  115.         goto L30;
  116.     }
  117. /*<       if (nchar.eq.8) go to 40 >*/
  118.     if (nchar == 8) {
  119.         goto L40;
  120.     }
  121. /*<       nchar=nchar+1 >*/
  122.     ++nchar;
  123. /*<       call move(sname,nchar,achar,1,1) >*/
  124.     move_(&sname, &nchar, &achar, &c__1, &c__1);
  125. /*<    20 continue >*/
  126. /* L20: */
  127.     }
  128. /*<    30 loc=nodplc(loc-1) >*/
  129. L30:
  130.     loc = nodplc[loc - 2];
  131. /*<       if (loc.eq.0) go to 60 >*/
  132.     if (loc == 0) {
  133.     goto L60;
  134.     }
  135. /*<       if (nchar.eq.8) go to 40 >*/
  136.     if (nchar == 8) {
  137.     goto L40;
  138.     }
  139. /*<       nchar=nchar+1 >*/
  140.     ++nchar;
  141. /*<       call move(sname,nchar,aper,1,1) >*/
  142.     move_(&sname, &nchar, &aper, &c__1, &c__1);
  143. /*<       go to 10 >*/
  144.     goto L10;
  145.  
  146. /*  name is longer than 8 characters:  flag with asterisk */
  147.  
  148. /*<    40 call move(sname,8,astk,1,1) >*/
  149. L40:
  150.     move_(&sname, &c__8, &astk, &c__1, &c__1);
  151. /*<    60 value(locve)=sname >*/
  152. L60:
  153.     blank_1.value[locve - 1] = sname;
  154.  
  155. /*  finished */
  156.  
  157. /*<   100 return >*/
  158. L100:
  159.     return 0;
  160. /*<       end >*/
  161. } /* subnam_ */
  162.  
  163. #undef cvalue
  164. #undef nodplc
  165. #undef astk
  166. #undef aper
  167. #undef ablank
  168.  
  169.  
  170.